home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qb4inp.arc / QB4INPUT.BAS
Encoding:
BASIC Source File  |  1987-11-24  |  12.6 KB  |  437 lines
  1. ' (c) 1987 by Paul M. Friedman
  2. ' placed in the Public Domain
  3.  
  4. ' requires QucikBasic 4.0
  5.  
  6.  
  7.  
  8. CONST false = 0, true = NOT false
  9.  
  10. DECLARE SUB Border (title AS STRING)
  11. DECLARE SUB GoodFile (y%, x%, filename$, ok%)
  12. DECLARE FUNCTION FileExists% (filename$)
  13. DECLARE FUNCTION OneChr$ (y%, x%, GoodList$)
  14. DECLARE FUNCTION NoShow$ (GoodList$)
  15. DECLARE FUNCTION OneInt% (y%, x%, mn%, mx%)
  16. DECLARE FUNCTION IntIn% (y%, x%, mn%, mx%, length%)
  17. DECLARE FUNCTION Int2% (y%, x%, mn%, mx%)
  18. DECLARE FUNCTION LongIn& (y%, x%, mn&, mx&, length%)
  19. DECLARE FUNCTION WholeIn! (y%, x%, mn!, mx!, length%)
  20. DECLARE FUNCTION StrIn$ (y%, x%, length%)
  21. DECLARE FUNCTION BlankIn$ (y%, x%, length%)
  22. DECLARE FUNCTION YesNo% (y%, x%)
  23. DECLARE FUNCTION Point2In (y%, x%, mn!, mx!, length%)
  24. DECLARE FUNCTION OnePt2! (y%, x%, mn!, mx!)
  25.  
  26.  
  27. '  Input Routines using QuickBasic 4.0 FUNCTIONS
  28. '        y% & x% are used as LOCATE y%, x%
  29.  
  30. '  Border [SUBROUTINE, not Function] : displays border & centers optinal
  31. '              title [highlited] on top of border
  32. '  GoodFile [SUBROUTINE, not Function] : checks a string to be sure
  33. '               it is 1-8 characters in length & contains only letters
  34. '               and/or numbers
  35.  
  36. '  FileExists returns true (-1) if file exists; false(0) otherwise
  37.  
  38. '  OneChr$: accepts a string of LEN=1; checks to see if it is contained
  39. '               is GoodList$ [after capitalizing the input], beeps until
  40. '               a valid input is made.  no <enter> key
  41.  
  42. '  NoShow$: as OneChr$, but no prompt { ■ } nor is input echoed to screen
  43.  
  44. '  OneInt%: accepts a single digit. checks to see if it is >=mn% and
  45. '                <= mx.    no <enter> key
  46.  
  47. '  IntIn%:  accepts integer input of length% length; must be >=mn% & <=mx%
  48. '                  Positive ##'s only.
  49.  
  50. '  Int2%:  2 digit input. must use 02 for 2, etc.  no <enter> key
  51.  
  52. '  LongIn&:  as IntIn% but for LONG Integers
  53.  
  54. '  WholeIn!: as IntIn% but for SINGLES.
  55.  
  56. '  StrIn$:  accepts string input of LEN=(1 to length%)
  57.  
  58. '  BlankIn$: accepts string input of LEN=0 to length%)
  59.  
  60. '  YesNo$:   accepts Y or N [forces caps]. return true if Y, false if N
  61. '                 echoes "Yes" or "No" to screen
  62.  
  63. '  Point2In!: accepts input of real number of max whole number length of
  64. '             of length% plus optional decimal point and 1 or 2 digits following
  65.  
  66. '  OnePt2!: Whole number + 2 decimal places. forced, no <enter> key
  67.  
  68.  
  69. ' Note that IntIn, LongIn, WholeIn, Point2In format output.
  70.  
  71. FUNCTION BlankIn$ (y%, x%, length%)
  72.    COLOR 11, 0
  73.    LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
  74.    temp$ = ""
  75.    DO
  76.       t$ = INPUT$(1)
  77.       IF t$ = CHR$(13) THEN
  78.             PRINT SPACE$(length% - LEN(temp$));
  79.             COLOR 3, 0: EXIT DO
  80.          ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
  81.             temp$ = LEFT$(temp$, LEN(temp$) - 1)
  82.             PRINT CHR$(29); CHR$(254); CHR$(29);
  83.          ELSEIF LEN(temp$) = length% THEN
  84.             BEEP
  85.          ELSEIF t$ < " " OR t$ > "~" THEN
  86.             BEEP
  87.          ELSE
  88.             temp$ = temp$ + t$
  89.             PRINT t$;
  90.       END IF
  91.    LOOP
  92.    BlankIn$ = temp$
  93.  
  94. END FUNCTION
  95.  
  96. SUB Border (title AS STRING)
  97.     CLS
  98.     COLOR 3, 0
  99.     LOCATE 3, 5: PRINT CHR$(201); STRING$(69, 205); CHR$(187);
  100.     FOR i% = 4 TO 22
  101.       LOCATE i%, 5: PRINT CHR$(186); : LOCATE , 75: PRINT CHR$(186);
  102.     NEXT
  103.     LOCATE 23, 5: PRINT CHR$(200); STRING$(69, 205); CHR$(188);
  104.     IF title$ <> "" THEN
  105.        COLOR 11, 0
  106.        LOCATE 3, 40 - LEN(title$) \ 2: PRINT title$;
  107.     END IF
  108.     COLOR 3, 0
  109. END SUB
  110.  
  111. FUNCTION FileExists% (filename$)
  112.    filenum = FREEFILE
  113.    OPEN filename$ FOR RANDOM AS filenum LEN = 1
  114.    IF LOF(filenum) = 0 THEN
  115.       FileExists% = false
  116.       CLOSE filenum
  117.       KILL filename$
  118.      ELSE
  119.       FileExists% = true
  120.       CLOSE filenum
  121.    END IF
  122. END FUNCTION
  123.  
  124. SUB GoodFile (y%, x%, filename$, ok%)
  125.    filename$ = UCASE$(StrIn$(y%, x%, 8))
  126.    FOR i% = 1 TO LEN(filename$)
  127.       t$ = MID$(filename$, i%, 1)
  128.       IF t$ > "Z" OR t$ < "A" THEN
  129.          IF t$ < "0" OR t$ > "9" THEN
  130.             BEEP: ok% = false: EXIT SUB
  131.          END IF
  132.       END IF
  133.     NEXT
  134.     ok% = true
  135. END SUB
  136.  
  137. FUNCTION Int2% (y%, x%, mn%, mx%)
  138.    temp$ = "": COLOR 11, 0
  139.    DO
  140.       LOCATE y%, x%: PRINT STRING$(2, 254); STRING$(2, 29);
  141.       DO
  142.          temp$ = INPUT$(1)
  143.          IF temp$ < "0" OR temp$ > "9" THEN
  144.                BEEP
  145.             ELSEIF VAL(temp$ + "9") < mn% THEN
  146.                BEEP
  147.             ELSEIF VAL(temp$ + "0") > mx% THEN
  148.                BEEP
  149.             ELSE
  150.                PRINT temp$;
  151.                EXIT DO
  152.          END IF
  153.       LOOP
  154.       DO
  155.          t$ = INPUT$(1)
  156.          IF t$ < "0" OR t$ > "9" THEN
  157.                BEEP
  158.             ELSEIF VAL(temp$ + t$) < mn% OR VAL(temp$ + t$) > mx% THEN
  159.                BEEP
  160.                EXIT DO
  161.             ELSE
  162.                PRINT t$;
  163.                Int2% = VAL(temp$ + t$)
  164.                COLOR 3, 0
  165.                EXIT FUNCTION
  166.          END IF
  167.       LOOP
  168.    LOOP
  169. END FUNCTION
  170.  
  171. FUNCTION IntIn% (y%, x%, mn%, mx%, length%)
  172.    COLOR 11, 0
  173.    DO
  174.       temp$ = ""
  175.       LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
  176.       DO
  177.          t$ = INPUT$(1)
  178.          IF t$ = CHR$(13) AND temp$ <> "" THEN
  179.             IF VAL(temp$) < mn% OR VAL(temp$) > mx% THEN
  180.                BEEP: EXIT DO
  181.             ELSE
  182.                PRINT STRING$(length% - LEN(temp$), 32);
  183.                frmt$ = STRING$(length%, "#") + ","
  184.                LOCATE y%, x%
  185.                PRINT USING frmt$; VAL(temp$);
  186.                IntIn% = VAL(temp$)
  187.                COLOR 3, 0
  188.                EXIT FUNCTION
  189.             END IF
  190.          ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
  191.             temp$ = LEFT$(temp$, LEN(temp$) - 1)
  192.             PRINT CHR$(29); CHR$(254); CHR$(29);
  193.          ELSEIF LEN(temp$) = length% THEN
  194.             BEEP
  195.          ELSEIF t$ < "0" OR t$ > "9" THEN
  196.             BEEP
  197.          ELSE
  198.             temp$ = temp$ + t$: PRINT t$;
  199.          END IF
  200.       LOOP
  201.    LOOP
  202. END FUNCTION
  203.  
  204. FUNCTION LongIn& (y%, x%, mn&, mx&, length%)
  205.    COLOR 11, 0
  206.    DO
  207.       temp$ = ""
  208.       LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
  209.       DO
  210.          t$ = INPUT$(1)
  211.          IF t$ = CHR$(13) AND temp$ <> "" THEN
  212.             IF VAL(temp$) < mn& OR VAL(temp$) > mx& THEN
  213.                BEEP: EXIT DO
  214.             ELSE
  215.                PRINT STRING$(length% - LEN(temp$), 32);
  216.                frmt$ = STRING$(length%, "#") + STRING$(length% \ 3, ",")
  217.                LOCATE y%, x%
  218.                PRINT USING frmt$; VAL(temp$);
  219.                LongIn& = VAL(temp$)
  220.                COLOR 3, 0
  221.                EXIT FUNCTION
  222.             END IF
  223.          ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
  224.             temp$ = LEFT$(temp$, LEN(temp$) - 1)
  225.             PRINT CHR$(29); CHR$(254); CHR$(29);
  226.          ELSEIF LEN(temp$) = length% THEN
  227.             BEEP
  228.          ELSEIF t$ < "0" OR t$ > "9" THEN
  229.             BEEP
  230.          ELSE
  231.             temp$ = temp$ + t$: PRINT t$;
  232.          END IF
  233.       LOOP
  234.    LOOP
  235. END FUNCTION
  236.  
  237. FUNCTION NoShow$ (GoodList$)
  238.     temp$ = " "
  239.     WHILE INSTR(GoodList$, temp$) = 0
  240.        temp$ = INPUT$(1)
  241.        temp$ = UCASE$(temp$)
  242.        IF INSTR(GoodList$, temp$) = 0 THEN BEEP
  243.     WEND
  244.     NoShow$ = temp$
  245. END FUNCTION
  246.  
  247. FUNCTION OneChr$ (y%, x%, GoodList$)
  248.     COLOR 11, 0: LOCATE y%, x%: PRINT CHR$(254); CHR$(29);
  249.     temp$ = " "
  250.     WHILE INSTR(GoodList$, temp$) = 0
  251.        temp$ = INPUT$(1)
  252.        temp$ = UCASE$(temp$)
  253.        IF INSTR(GoodList$, temp$) = 0 THEN BEEP
  254.     WEND
  255.     PRINT temp$;
  256.     COLOR 3, 0
  257.     OneChr$ = temp$
  258. END FUNCTION
  259.  
  260. FUNCTION OneInt% (y%, x%, mn%, mx%)
  261.    COLOR 11, 0: LOCATE y%, x%: PRINT CHR$(254); CHR$(29);
  262.    temp$ = ""
  263.    WHILE temp$ = "" OR VAL(temp$) < mn% OR VAL(temp$) > mx%
  264.       temp$ = INPUT$(1)
  265.       IF temp$ < "0" OR temp$ > "9" THEN
  266.             BEEP: temp$ = ""
  267.          ELSEIF VAL(temp$) < mn% OR VAL(temp$) > mx% THEN
  268.             BEEP: temp$ = ""
  269.       END IF
  270.       PRINT temp$;
  271.       OneInt% = VAL(temp$)
  272.       COLOR 3, 0
  273.    WEND
  274. END FUNCTION
  275.  
  276. FUNCTION OnePt2 (y%, x%, mn, mx)
  277.    COLOR 11, 0
  278.    DO
  279.       LOCATE y%, x%: PRINT "■.■■";
  280.       LOCATE y%, x%: temp$ = ""
  281.       DO
  282.          t$ = INPUT$(1)
  283.          IF t$ < "0" OR t$ > "9" THEN
  284.                BEEP
  285.             ELSEIF VAL(t$) + .99 < mn OR VAL(t$) > mx THEN
  286.                BEEP
  287.             ELSE
  288.                temp$ = t$ + "."
  289.                PRINT t$; "."
  290.                LOCATE y%, x% + 2
  291.          END IF
  292.       LOOP WHILE temp$ = ""
  293.       DO WHILE LEN(temp$) = 2
  294.          LOCATE y%, x% + 2
  295.          t$ = INPUT$(1)
  296.          IF t$ = CHR$(8) THEN
  297.                EXIT DO
  298.             ELSEIF VAL(temp$ + t$) + .09 < mn OR VAL(temp$ + t$) > mx THEN
  299.                BEEP
  300.                EXIT DO
  301.             ELSEIF t$ < "0" OR t$ > "9" THEN
  302.                BEEP
  303.             ELSE
  304.                temp$ = temp$ + t$
  305.                PRINT t$;
  306.          END IF
  307.       LOOP
  308.       DO WHILE LEN(temp$) = 3
  309.          LOCATE y%, x% + 3
  310.          t$ = INPUT$(1)
  311.          IF t$ = CHR$(8) THEN
  312.                temp$ = LEFT$(temp$, 2)
  313.                PRINT CHR$(29); CHR$(254); CHR$(29);
  314.             ELSEIF t$ < "0" OR t$ > "9" THEN
  315.                BEEP
  316.             ELSEIF VAL(temp$ + t$) < mn OR VAL(temp$ + t$) > mx THEN
  317.                BEEP
  318.                EXIT DO
  319.             ELSE
  320.                temp$ = temp$ + t$
  321.                PRINT t$;
  322.                OnePt2 = VAL(temp$)
  323.                COLOR 3, 0
  324.                EXIT FUNCTION
  325.          END IF
  326.        LOOP
  327.    LOOP
  328. END FUNCTION
  329.  
  330. FUNCTION Point2In (y%, x%, mn, mx, length%)
  331.    COLOR 11, 0
  332.    DO
  333.       LOCATE y%, x%: PRINT STRING$(length% + 3, 254);
  334.       LOCATE y%, x%: temp$ = ""
  335.       DO
  336.          t$ = INPUT$(1)
  337.          IF t$ = CHR$(13) AND temp$ <> "" THEN
  338.                EXIT DO
  339.             ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
  340.                temp$ = LEFT$(temp$, LEN(temp$) - 1)
  341.                PRINT CHR$(29); CHR$(254); CHR$(29);
  342.             ELSEIF LEN(temp$) = length% + 3 THEN
  343.                BEEP
  344.             ELSEIF t$ = "." AND INSTR(temp$, t$) = 0 THEN
  345.                temp$ = temp$ + t$: PRINT t$;
  346.             ELSEIF t$ < "0" OR t$ > "9" THEN
  347.                BEEP
  348.             ELSE
  349.                temp$ = temp$ + t$
  350.                PRINT t$;
  351.          END IF
  352.       LOOP
  353.       IF VAL(temp$) < mn OR VAL(temp$) > mx THEN BEEP ELSE EXIT DO
  354.    LOOP
  355.    Point2In = VAL(temp$)
  356.    LOCATE y%, x%: PRINT STRING$(length% + 3, 32); : LOCATE y%, x%
  357.    frmt$ = STRING$(length%, "#") + STRING$(length% \ 3, ",") + ".##"
  358.    PRINT USING frmt$; VAL(temp$);
  359.    COLOR 3, 0
  360. END FUNCTION
  361.  
  362. FUNCTION StrIn$ (y%, x%, length%)
  363.    COLOR 11, 0
  364.    LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
  365.    temp$ = ""
  366.    DO
  367.       t$ = INPUT$(1)
  368.       IF t$ = CHR$(13) AND temp$ <> "" THEN
  369.             PRINT SPACE$(length% - LEN(temp$));
  370.             COLOR 3, 0: EXIT DO
  371.          ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
  372.             temp$ = LEFT$(temp$, LEN(temp$) - 1)
  373.             PRINT CHR$(29); CHR$(254); CHR$(29);
  374.          ELSEIF LEN(temp$) = length% THEN
  375.             BEEP
  376.          ELSEIF t$ < " " OR t$ > "~" THEN
  377.             BEEP
  378.          ELSE
  379.             temp$ = temp$ + t$
  380.             PRINT t$;
  381.       END IF
  382.    LOOP
  383.    StrIn$ = temp$
  384. END FUNCTION
  385.  
  386. FUNCTION WholeIn (y%, x%, mn, mx, length%)
  387.    COLOR 11, 0
  388.    DO
  389.       temp$ = ""
  390.       LOCATE y%, x%: PRINT STRING$(length%, 254); : LOCATE y%, x%
  391.       DO
  392.          t$ = INPUT$(1)
  393.          IF t$ = CHR$(13) AND temp$ <> "" THEN
  394.             IF VAL(temp$) < mn OR VAL(temp$) > mx THEN
  395.                BEEP: EXIT DO
  396.             ELSE
  397.                PRINT STRING$(length% - LEN(temp$), 32);
  398.                frmt$ = STRING$(length%, "#") + STRING$(length% \ 3, ",")
  399.                LOCATE y%, x%
  400.                PRINT USING frmt$; VAL(temp$);
  401.                WholeIn = VAL(temp$)
  402.                COLOR 3, 0
  403.                EXIT FUNCTION
  404.             END IF
  405.          ELSEIF t$ = CHR$(8) AND temp$ <> "" THEN
  406.             temp$ = LEFT$(temp$, LEN(temp$) - 1)
  407.             PRINT CHR$(29); CHR$(254); CHR$(29);
  408.          ELSEIF LEN(temp$) = length% THEN
  409.             BEEP
  410.          ELSEIF t$ < "0" OR t$ > "9" THEN
  411.             BEEP
  412.          ELSE
  413.             temp$ = temp$ + t$: PRINT t$;
  414.          END IF
  415.       LOOP
  416.    LOOP
  417. END FUNCTION
  418.  
  419. FUNCTION YesNo% (y%, x%)
  420.    COLOR 11, 0: LOCATE y%, x%: PRINT CHR$(254); CHR$(29);
  421.    DO
  422.       t$ = UCASE$(INPUT$(1))
  423.       IF t$ = "Y" THEN
  424.          YesNo% = true
  425.          PRINT "Yes";
  426.          EXIT DO
  427.       ELSEIF t$ = "N" THEN
  428.          YesNo% = false
  429.          PRINT "No";
  430.          EXIT DO
  431.       END IF
  432.       BEEP
  433.     LOOP
  434.     COLOR 3, 0
  435. END FUNCTION
  436.  
  437.